home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
ctlib100.zip
/
INSTALL.LZH
/
BITREES1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-10-12
|
4KB
|
145 lines
{**************************************************************************}
{* BitSoft Development, L.L.C. *}
{* Copyright (C) 1995, 1996 BitSoft Development, L.L.C. *}
{* All rights reserved. *}
{* Containers Library demo *}
{**************************************************************************}
program BiTrees1;
{$X+}
{ Sample program for using a binary tree. }
uses Objects, Containr, ctBiTree,
{$ifdef Windows}
WinCtr;
{$else}
Crt;
{$endif}
type
PContact = ^TContact;
TContact = object (TBinaryNode)
FirstName,
LastName,
Phone,
Company : PString;
constructor Init(ALastName, AFirstName, APhone, ACompany : string);
function KeyOf : Pointer; virtual;
destructor Done; virtual;
end; { TContact }
constructor TContact.Init(ALastName, AFirstName, APhone, ACompany : string);
begin
TBinaryNode.Init;
FirstName := NewStr(AFirstName);
LastName := NewStr(ALastName);
Phone := NewStr(APhone);
Company := NewStr(ACompany);
end;
destructor TContact.Done;
begin
DisposeStr(FirstName);
DisposeStr(LastName);
DisposeStr(Phone);
DisposeStr(Company);
TBinaryNode.Done;
end;
function TContact.KeyOf : Pointer;
begin
KeyOf := LastName;
end;
procedure DisplayContacts(ContactList : PGraph);
procedure PrintInfo (Item : Pointer); far;
begin
with PContact(Item)^ do
writeln(LastName^, '':15 - Length(LastName^),
FirstName^, '':15 - Length(FirstName^),
Phone^, '':20 - Length(Phone^),
Company^, '':20 - Length(Company^));
end;
begin
ContactList^.ForEach(@PrintInfo);
end;
procedure DisplayFirst(ContactList : PGraph);
var
Item : Pointer;
begin
Item := ContactList^.First;
Writeln('First item:');
with PContact(Item)^ do
writeln(LastName^, '':15 - Length(LastName^),
FirstName^, '':15 - Length(FirstName^),
Phone^, '':20 - Length(Phone^),
Company^, '':20 - Length(Company^));
ContactList^.DoneItem(Item); { not required }
end;
procedure DisplayLast(ContactList : PGraph);
var
Item : Pointer;
begin
Item := ContactList^.Last;
Writeln('Last item:');
with PContact(Item)^ do
writeln(LastName^, '':15 - Length(LastName^),
FirstName^, '':15 - Length(FirstName^),
Phone^, '':20 - Length(Phone^),
Company^, '':20 - Length(Company^));
ContactList^.DoneItem(Item); { not required }
end;
procedure FindLastName(ContactList : PGraph; LastName : string);
var
Item : Pointer;
begin
Item := ContactList^.KeyFirst(@LastName);
Writeln('Item found with last name ''', LastName, ''':');
with PContact(Item)^ do
writeln(LastName^, '':15 - Length(LastName^),
FirstName^, '':15 - Length(FirstName^),
Phone^, '':20 - Length(Phone^),
Company^, '':20 - Length(Company^));
ContactList^.DoneItem(Item); { not required }
end;
var
ContactInfo : PBinaryTree;
begin
ClrScr;
{ Create the collection }
ContactInfo := New(PBinaryTree, Init);
{ Insert items into the collection }
with ContactInfo^ do
begin
Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
'Running, Corp.')));
Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
'ER, Inc.')));
Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
'Symphony, Ltd.')));
Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
'InterComm, Corp.')));
end; { with }
DisplayContacts(ContactInfo);
Writeln;
DisplayFirst(ContactInfo);
Writeln;
DisplayLast(ContactInfo);
Writeln;
FindLastName(ContactInfo, 'Wagner');
{ Dispose of the collection and all the objects in it }
Dispose(ContactInfo, Done);
end.